home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / C-H / Finder Progress Pascal.cpt / Finder Progress Pascal / Routines.p < prev   
Text File  |  1993-01-03  |  5KB  |  171 lines
  1. unit Routines; {from Finder Progress by Joe Zobkiw, Pascal translation by Mike Epstein}
  2. interface
  3.     const
  4.         kGrayProgressColorRed = 17476;
  5.         kGrayProgressColorGreen = 17476;
  6.         kGrayProgressColorBlue = 17476;
  7.  
  8.         kPurpleProgressColorRed = -13108; {52428 as an integer}
  9.         kPurpleProgressColorGreen = -13108; {52428 as an integer}
  10.         kPurpleProgressColorBlue = -1; {65535 as an integer}
  11.  
  12.         kAboutAlertID = 129;
  13.         kModalProgressDialogID = 128;
  14.         kDialogProgressItem = 1;
  15.         kColorBitDepth = 8;
  16.  
  17.     procedure UpdateProgress (r: Rect; percentage: Integer; color: Boolean);
  18.     function DItemRect (dialog: DialogPtr; item: Integer): Rect;
  19.     function ColorQDIsPresent: Boolean;
  20.     function BitDepth: Integer;
  21.  
  22. implementation
  23.  
  24. {********************************************************************}
  25. {    UpdateProgress}
  26. {    }
  27. {    draws the progress item, expects the port to be set properly.}
  28. {    You can pass any parameters you like into this routine, it}
  29. {    depends on the situation you plan on using it in. I decided}
  30. {    to simply pass a Rect, percentage, and a color flag.}
  31. {    }
  32. {    this implementation draws the entire thermometer each time}
  33. {    which will cause the cursor to flicker if you move it over the}
  34. {    thermometer itself. i do this for a few reasons, one being I}
  35. {    didn't want the overhead or hassle of allocating an offscreen}
  36. {    pixmap or bitmap to provide flicker free animation, and secondly}
  37. {    if we are drawing and a screensaver goes on, when it kicks out}
  38. {    again we will be sure to draw the entire thermometer immediately}
  39. {    and not just a portion of it.}
  40. {    }
  41. {********************************************************************}
  42.     procedure UpdateProgress (r: Rect; percentage: Integer; color: Boolean);
  43.         var
  44.             rgb: RGBColor;
  45.             theRect, fillRect, emptyRect: Rect;
  46.             savePen: PenState;
  47.             theForeColor: RGBColor;
  48.             offset: Integer;
  49.     begin
  50.         theRect := r;
  51.         fillRect := r;
  52.         emptyRect := r;
  53.  
  54.     {save the pen state and color}
  55.         GetPenState(savePen);
  56.         if color then
  57.             GetForeColor(theForeColor);
  58.         PenNormal;
  59.  
  60.     {first frame the rectangle}
  61.         if color then
  62.             begin
  63.                 rgb.red := 0;
  64.                 rgb.green := 0;
  65.                 rgb.blue := 0;
  66.                 RGBForeColor(rgb);
  67.             end
  68.         else
  69.             ForeColor(blackColor);
  70.         FrameRect(theRect);
  71.  
  72.     {figure out the percentage}
  73.         InsetRect(theRect, 1, 1);
  74.         InsetRect(fillRect, 1, 1);
  75.         InsetRect(emptyRect, 1, 1);
  76.         offset := Round((theRect.right - theRect.left) * percentage / 100);
  77.  
  78.     {first draw the filled in portion}
  79.         fillRect.right := fillRect.left + offset;
  80.         if color then
  81.             begin
  82.                 rgb.red := kGrayProgressColorRed;
  83.                 rgb.green := kGrayProgressColorGreen;
  84.                 rgb.blue := kGrayProgressColorBlue;
  85.                 RGBForeColor(rgb);
  86.             end
  87.         else
  88.             ForeColor(blackColor);
  89.         PaintRect(fillRect);
  90.  
  91.     {now draw the unfilled portion}
  92.         emptyRect.left := fillRect.right + 1;
  93.         if color then
  94.             with rgb do
  95.                 begin
  96. {red := 32767;}
  97. {green := 32767;}
  98. {blue := 32767;}
  99.  
  100.  
  101.                     red := kPurpleProgressColorRed;
  102.                     green := kPurpleProgressColorGreen;
  103.                     blue := kPurpleProgressColorBlue;
  104.                     RGBForeColor(rgb);
  105.                 end
  106.         else
  107.             ForeColor(whiteColor);
  108.         PaintRect(emptyRect);
  109.  
  110.     {restore pen settings, colors, restore to black when not in color}
  111.         SetPenState(savePen);
  112.         if color then
  113.             RGBForeColor(theForeColor)
  114.         else
  115.             ForeColor(blackColor);
  116.     end;
  117.  
  118. {********************************************************************}
  119. {    DItemRect}
  120. {    }
  121. {    returns the rectangle of a dialog item}
  122. {  }
  123. {********************************************************************}
  124.  
  125.     function DItemRect (dialog: DialogPtr; item: Integer): Rect;
  126.         var
  127.             itemType: Integer;
  128.             itemHandle: Handle;
  129.             itemRect: Rect;
  130.     begin
  131.         GetDItem(dialog, item, itemType, itemHandle, itemRect);
  132.         DItemRect := itemRect;
  133.     end;
  134.  
  135. {********************************************************************}
  136. {    ColorQDIsPresent}
  137. {    }
  138. {    returns true if color quickdraw is present, false otherwise}
  139. {********************************************************************}
  140.  
  141.     function ColorQDIsPresent: Boolean;
  142.         var
  143.             theWorld: SysEnvRec;
  144.             i: integer;
  145.     begin
  146.         i := SysEnvirons(1, theWorld);
  147.         ColorQDIsPresent := theWorld.hasColorQD;
  148.     end;
  149.  
  150. {********************************************************************}
  151. {    BitDepth}
  152. {    }
  153. {    returns the bitdepth of the main monitor}
  154. {********************************************************************}
  155.  
  156.     function BitDepth: Integer;
  157.         var
  158.             bits: Integer;
  159.             mainDevice: GDHandle;
  160.             pixMap: PixMapHandle;
  161.     begin
  162.         bits := 1;
  163.         if ColorQDIsPresent then
  164.             begin
  165.                 mainDevice := GetMainDevice;
  166.                 pixMap := mainDevice^^.gdPMap;
  167.                 bits := pixMap^^.pixelSize;
  168.             end;
  169.         BitDepth := bits;
  170.     end;
  171. end.